home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
qbbs
/
qkratop.zip
/
QKRATOP.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1990-10-18
|
14KB
|
456 lines
Program QkRATop;
Uses
Dos, Crt, OpRoot, OpString;
Const
Clear = #27+'[2J';
Default = #27+'[0m';
Bold = #27+'[1m';
Blink = #27+'[5m';
Colors : array[0..15] of string[5] =
(
#27+'[30m', #27+'[31m', #27+'[32m', #27+'[33m',
#27+'[34m', #27+'[35m', #27+'[36m', #27+'[37m',
#27+'[40m', #27+'[41m', #27+'[42m', #27+'[43m',
#27+'[44m', #27+'[45m', #27+'[46m', #27+'[47m'
);
Type
string35 = string[35];
OneLine = string[80];
FlagType = ARRAY[1..4] of byte;
USERSrecord = RECORD
Name : string[35];
Location : string[25];
Password : string[15];
DataPhone,
VoicePhone : string[12];
LastTime : string[5];
LastDate : string[8];
Attribute : byte;
Flags : FlagType;
Credit,
Pending : word;
MsgsPosted,
LastRead,
Security,
NoCalls,
Uploads,
Downloads,
UploadsK,
DownloadsK : word;
TodayK,
Elapsed : integer;
ScreenLength : word;
LastPwdChange,
Attribute2 : byte;
ExtraSpace : ARRAY[1..6] OF byte;
END;
CONFIGdata = record { Holds the program configuration data }
SystemName : OneLine;
Sysop : OneLine;
UserFile : OneLine;
OutFile : OneLine;
HiIntensity : boolean;
fFrame, bFrame,
fHead, bHead,
fData, bData,
fHiLit, bHiLit : byte;
End;
DataPtr = ^DataRec;
DataRec = object(SingleListNode)
Name : string35;
Number : word;
constructor Init(InitName : string35; InitNum : word);
function GetName : string35;
function GetNum : word;
end;
Var
CFG : CONFIGdata;
User : USERSrecord;
UserFile : FILE of USERSrecord;
AnsiOut : TEXT;
AsciOut : TEXT;
TOPcallers : SingleList;
TOPposters : SingleList;
TOPuploads : SingleList;
Temp : DataPtr;
fFr, bFr,
fHd, bHd,
fDat, bDat,
fHi, bHi : string[5];
constructor DataRec.Init;
begin
if NOT SingleListNode.Init then Fail;
Name := InitName;
Number := InitNum;
end;
function DataRec.GetName;
begin
GetName := Name;
end;
function DataRec.GetNum;
begin
GetNum := Number;
end;
Procedure Title;
Begin
ClrScr;
Writeln(' QkRATop v1.0');
Writeln;
Writeln(' Remote Access BBS TOPTEN Screen Generator');
Writeln(' Copyright (c) 1990 Chrstopher Hall (505)821-5341');
Writeln(' ALL RIGHTS RESERVED');
Writeln;
End;
Procedure LoadConfig;
var
ConfigFile : Text;
sTemp : string;
Begin
Assign(ConfigFile,'QkRATOP.CFG');
{$I-}
Reset(ConfigFile);
{$I+}
IF IOresult = 0 Then
Begin
Reset(ConfigFile);
Readln(ConfigFile, CFG.SystemName);
Readln(ConfigFile, CFG.Sysop);
Readln(ConfigFile, CFG.UserFile);
Readln(ConfigFile, CFG.OutFile);
Readln(ConfigFile, sTemp);
CFG.HiIntensity := (upcase(sTemp[1]) = 'H');
Read(ConfigFile, CFG.fFrame); Readln(ConfigFile, CFG.bFrame);
Read(ConfigFile, CFG.fHead); Readln(ConfigFile, CFG.bHead);
Read(ConfigFile, CFG.fData); Readln(ConfigFile, CFG.bData);
Read(ConfigFile, CFG.fHiLit); Readln(ConfigFile, CFG.bHiLit);
Close(ConfigFile);
End
Else
Begin
Writeln('ERROR: Reading configuration file.');
Halt(1); { Quit the program }
End;
fFr := Colors[CFG.fFrame]; bFr := Colors[CFG.bFrame];
fHd := Colors[CFG.fHead]; bHd := Colors[CFG.bHead];
fDat := Colors[CFG.fData]; bDat := Colors[CFG.bData];
fHi := Colors[CFG.fHiLit]; bHi := Colors[CFG.bHiLit];
End;
Procedure DoScan;
var
NewTemp : DataPtr;
begin
TOPcallers.Init;
TOPposters.Init;
TOPuploads.Init;
assign(UserFile, CFG.UserFile);
{$I-}
reset(UserFile);
{$I+}
if IOResult <> 0 then
begin
writeln('ERROR: Unable to locate USERS.BBS');
Halt;
end;
read(UserFile, User); {Skip SYSOP Entry}
while NOT EOF(UserFile) do
begin
read(UserFile, User);
{**** TOP Callers ****}
if TOPcallers.Size < 10 then {Size of Linked List is < 10}
begin
Temp := DataPtr(TOPcallers.Head);
if Temp = nil then
begin
New(Temp, Init(User.Name, User.NoCalls));
TOPcallers.Append(Temp);
end
else
while Temp <> nil do
begin
if User.NoCalls > Temp^.GetNum then
begin
New(NewTemp, Init(User.Name, User.NoCalls));
TOPcallers.PlaceBefore(NewTemp, Temp);
Temp := nil;
end
else
begin
Temp := DataPtr(TOPcallers.Next(Temp));
if Temp = nil then
begin
New(NewTemp, Init(User.Name, User.NoCalls));
TOPcallers.Append(NewTemp);
end;
end;
end;
end
else {Size of Linked List is already at Maximum}
begin
Temp := DataPtr(TOPcallers.Head);
while Temp <> nil do
begin
if User.NoCalls > Temp^.GetNum then
begin
New(NewTemp, Init(User.Name, User.NoCalls));
TOPcallers.PlaceBefore(NewTemp, Temp);
Temp := DataPtr(TOPcallers.Tail);
TOPcallers.Delete(Temp);
Temp := nil;
end
else
Temp := DataPtr(TOPcallers.Next(Temp));
end;
end;
{**** TOP Message Posters ****}
if TOPposters.Size < 10 then {Size of Linked List is < 10}
begin
Temp := DataPtr(TOPposters.Head);
if Temp = nil then
begin
New(Temp, Init(User.Name, User.MsgsPosted));
TOPposters.Append(Temp);
end
else
while Temp <> nil do
begin
if User.MsgsPosted > Temp^.GetNum then
begin
New(NewTemp, Init(User.Name, User.MsgsPosted));
TOPposters.PlaceBefore(NewTemp, Temp);
Temp := nil;
end
else
begin
Temp := DataPtr(TOPposters.Next(Temp));
if Temp = nil then
begin
New(NewTemp, Init(User.Name, User.MsgsPosted));
TOPposters.Append(NewTemp);
end;
end;
end;
end
else {Size of Linked List is already at Maximum}
begin
Temp := DataPtr(TOPposters.Head);
while Temp <> nil do
begin
if User.MsgsPosted > Temp^.GetNum then
begin
New(NewTemp, Init(User.Name, User.MsgsPosted));
TOPposters.PlaceBefore(NewTemp, Temp);
Temp := DataPtr(TOPposters.Tail);
TOPposters.Delete(Temp);
Temp := nil;
end
else
Temp := DataPtr(TOPposters.Next(Temp));
end;
end;
{**** TOP Uploaders ****}
if TOPuploads.Size < 10 then {Size of Linked List is < 10}
begin
Temp := DataPtr(TOPuploads.Head);
if Temp = nil then
begin
New(Temp, Init(User.Name, User.Uploads));
TOPuploads.Append(Temp);
end
else
while Temp <> nil do
begin
if User.Uploads > Temp^.GetNum then
begin
New(NewTemp, Init(User.Name, User.Uploads));
TOPuploads.PlaceBefore(NewTemp, Temp);
Temp := nil;
end
else
begin
Temp := DataPtr(TOPuploads.Next(Temp));
if Temp = nil then
begin
New(NewTemp, Init(User.Name, User.Uploads));
TOPuploads.Append(NewTemp);
end;
end;
end;
end
else {Size of Linked List is already at Maximum}
begin
Temp := DataPtr(TOPuploads.Head);
while Temp <> nil do
begin
if User.Uploads > Temp^.GetNum then
begin
New(NewTemp, Init(User.Name, User.Uploads));
TOPuploads.PlaceBefore(NewTemp, Temp);
Temp := DataPtr(TOPuploads.Tail);
TOPuploads.Delete(Temp);
Temp := nil;
end
else
Temp := DataPtr(TOPuploads.Next(Temp));
end;
end;
end;
close(UserFile);
end;
Procedure WriteBulletins;
var
x, y : byte;
Up, Msg, Call : DataPtr;
sLine, sTemp : string;
begin
writeln('Writing Ascii Bulletin.');
writeln('Writing Ansi Bulletin.');
assign(AsciOut, CFG.OutFile+'.ASC');
assign(AnsiOut, CFG.OutFile+'.ANS');
rewrite(AsciOut);
rewrite(AnsiOut);
if CFG.HiIntensity then write(AnsiOut, Bold);
write(AnsiOut, Clear, fFr, bFr);
writeln(AsciOut);
writeln(AsciOut,'┌───────────────────────────────────────────────────────────────────────────┐');
writeln(AsciOut,'│ QkRemote Access Top Ten Users Bulletin │');
writeln(AsciOut,'│ Copyright (c) 1990 Christopher Hall │');
writeln(AsciOut,'├───────────────────────────────────────────────────────────────────────────┤');
write (AsciOut,'│');
sLine := 'System Name: ' + CFG.SystemName;
sLine := CenterCh(sLine, ' ', 75);
write(AsciOut, sLine);
writeln(AsciOut,'│');
write (AsciOut,'│');
sLine := 'Sysop: ' + CFG.Sysop;
sLine := CenterCh(sLine, ' ', 75);
write(AsciOut, sLine);
writeln(AsciOut,'│');
writeln(AsciOut,'├────────────────────────┬────────────────────────┬─────────────────────────┤');
writeln(AsciOut,'│ Best Uploaders │ Best Message Writers │ Best Callers │');
writeln(AsciOut,'└────────────────────────┴────────────────────────┴─────────────────────────┘');
writeln(AnsiOut,'┌───────────────────────────────────────────────────────────────────────────┐');
write (AnsiOut,'│');
write (AnsiOut, fHd, bHd);
write (AnsiOut,' QkRemote Access Top Ten Users Bulletin ');
write (AnsiOut, fFr, bFr);
writeln(AnsiOut,'│');
write (AnsiOut,'│');
write (AnsiOut, fHd, bHd);
write (AnsiOut,' Copyright (c) 1990 Christopher Hall ');
write (AnsiOut, fFr, bFr);
writeln(AnsiOut,'│');
writeln(AnsiOut,'├───────────────────────────────────────────────────────────────────────────┤');
write (AnsiOut,'│');
write (AnsiOut, fHd, bHd);
sLine := 'System Name: ' + CFG.SystemName;
sLine := CenterCh(sLine, ' ', 75);
write (AnsiOut, sLine);
write (AnsiOut, fFr, bFr);
writeln(AnsiOut,'│');
write (AnsiOut,'│');
write (AnsiOut, fHd, bHd);
sLine := 'Sysop: ' + CFG.Sysop;
sLine := CenterCh(sLine, ' ', 75);
write (AnsiOut, sLine);
write (AnsiOut, fFr, bFr);
writeln(AnsiOut,'│');
writeln(AnsiOut,'├────────────────────────┬────────────────────────┬─────────────────────────┤');
writeln(AnsiOut,'│ Best Uploaders │ Best Message Writers │ Best Callers │');
writeln(AnsiOut,'└────────────────────────┴────────────────────────┴─────────────────────────┘');
Up := DataPtr(TOPuploads.Head);
Msg := DataPtr(TOPposters.Head);
Call := DataPtr(TOPcallers.Head);
for x := 1 to 10 do
begin
sLine := ' '+ Up^.GetName; str(Up^.GetNum, sTemp);
write(AsciOut, sLine, ' ');
write(AnsiOut, fDat, bDat, sLine, ' ');
for y := length(sLine) to 22-length(sTemp) do
begin
write(AsciOut, '.');
write(AnsiOut, '.');
end;
write(AsciOut, sTemp);
write(AnsiOut, fHi, bHi, sTemp);
write(AsciOut, ' ');
write(AnsiOut, ' ');
sLine := Msg^.GetName; str(Msg^.GetNum, sTemp);
write(AsciOut, sLine, ' ');
write(AnsiOut, fDat, bDat, sLine, ' ');
for y := length(sLine) to 20-length(sTemp) do
begin
write(AsciOut, '.');
write(AnsiOut, '.');
end;
write(AsciOut, sTemp);
write(AnsiOut, fHi, bHi, sTemp);
write(AsciOut, ' ');
write(AnsiOut, ' ');
sLine := Call^.GetName; str(Call^.GetNum, sTemp);
write(AsciOut, sLine, ' ');
write(AnsiOut, fDat, bDat, sLine, ' ');
for y := length(sLine) to 22-length(sTemp) do
begin
write(AsciOut, '.');
write(AnsiOut, '.');
end;
writeln(AsciOut, sTemp);
writeln(AnsiOut, fHi, bHi, sTemp);
Up := DataPtr(TOPuploads.Next(Up));
Msg := DataPtr(TOPposters.Next(Msg));
Call := DataPtr(TOPcallers.Next(Call));
end;
writeln(AsciOut);
writeln(AnsiOut);
writeln(AsciOut, 'Press [Enter] to Continue: ');
write (AnsiOut, fFr, bFr, 'Press [');
write (AnsiOut, fHi, bHi, 'Enter', fFr, bFr);
writeln(AnsiOut, '] to Continue: ', Default);
close(AsciOut);
close(AnsiOut);
writeln;
writeln('Done!');
end;
begin
Title;
LoadConfig;
Writeln; Writeln('Scanning Users file. Please Wait...');
DoScan;
WriteBulletins;
TOPcallers.Done;
TOPposters.Done;
TOPuploads.Done;
End.